home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CU Amiga Super CD-ROM 11
/
CU Amiga Magazine's Super CD-ROM 11 (1997)(EMAP Images)(GB)(Track 1 of 3)[!][issue 1997-06].iso
/
cucd
/
programming
/
oberonv4
/
source
/
system
/
kepler6.mod
(
.txt
)
< prev
next >
Wrap
Oberon Text
|
1995-06-12
|
11KB
|
323 lines
Syntax10.Scn.Fnt
MODULE Kepler6;
(* Semesterarbeit Wintersemester 91/92 von Samuel Urech
Erweiterung des Graphikeditors Kepler um Splines
Programmiersprache: Oberon-2 auf Ceres-1
Autor: Samuel Urech, Tannenrauchstrasse 35/107, 8038 Z
Tel. 01 481 92 92 Stud.Nr. 87-906-434
Datum: 4.11.91 Stand: 6.2.92
J. Templ, 18.06.92, NewClosedBezier intriduced, NewOpenCRSpline renamed to NewCRSpline
J. Templ, 01.07.93 expressions simplified
IMPORT KeplerPorts, KeplerGraphs, KeplerFrames, Display, Math;
CONST Eps = 1.0E-6;
TYPE
CRSpline* = POINTER TO CRSplineDesc;
CRSplineDesc* = RECORD
( KeplerGraphs.ConsDesc )
END;
Bezier* = POINTER TO BezierDesc;
BezierDesc* = RECORD
( KeplerGraphs.ConsDesc )
END;
PROCEDURE Min( a, b : INTEGER ) : INTEGER;
BEGIN (* Min *)
IF a < b THEN RETURN a
ELSE RETURN b
END;
END Min;
PROCEDURE Max( a, b : INTEGER ) : INTEGER;
BEGIN (* Max *)
IF a < b THEN RETURN b
ELSE RETURN a
END;
END Max;
PROCEDURE GetBoundingBox( a3, a2, a1, a0, b3, b2, b1, b0 : REAL;
x1, y1, x2, y2 : INTEGER;
VAR x, y, w, h : INTEGER );
(* Berechnet ein Rechteck, in dem sich das zu zeichnende Kurvenst
ck vollst
ndig befindet.
a3, a2, a1, a0, b3, b2, b1, b0 sind die Koeffizienten der Kurve,
x1, y1, x2, y2 sind die Randpunkte. *)
VAR t, rt, temp : REAL;
x3, x4, y3, y4 : INTEGER;
BEGIN (* GetBoundingBox *)
IF ABS( a3 ) < Eps THEN
IF ABS( a2 ) < Eps THEN
x := Min( x1, x2 );
w := ABS( x2 - x1 );
ELSE
t := 0.5 * a1 / a2;
temp := t * ( a2 + t * a3 );
x3 := SHORT( ENTIER( a0 + t * ( a1 + temp ) ) );
x := Min( x1, Min( x2, x3 - 1 ) );
w := Max( x1, Max( x2, x3 + 1 ) ) - x;
END; (* IF *)
ELSE
rt := a2 * a2 - 3.0 * a1 * a3;
IF rt < 0 THEN
x := Min( x1, x2 );
w := ABS( x2 - x1 );
ELSE
rt := Math.sqrt( rt );
t := ( -a2 - rt ) / 3 / a3;
IF ( t > 0 ) & ( t < 1 ) THEN
temp := t * ( a2 + t * a3 );
x3 := SHORT( ENTIER( a0 + t * ( a1 + temp ) ) );
ELSE
x3 := x1;
END;
t := ( -a2 + rt ) / 3 / a3;
IF ( t > 0 ) & ( t < 1 ) THEN
temp := t * ( a2 + t * a3 );
x4 := SHORT( ENTIER( a0 + t * ( a1 + temp ) ) );
ELSE
x4 := x1;
END; (* IF *)
x := Min( x1, Min( x2, Min( x3, x4 ) - 1 ) );
w := Max( x1, Max( x2, Max( x3, x4 ) + 1 ) ) - x;
END; (* IF *)
END; (* IF *)
IF ABS( b3 ) < Eps THEN
IF ABS( b2 ) < Eps THEN
y := Min( y1, y2 );
h := ABS( y2 - y1 );
ELSE
t := 0.5 * b1 / b2;
temp := t * ( b2 + t * b3 );
y3 := SHORT( ENTIER( b0 + t * ( b1 + temp ) ) );
y := Min( y1, Min( y2, x3 - 1 ) );
h := Max( y1, Max( y2, y3 + 1 ) ) - y;
END; (* IF *)
ELSE
rt := b2 * b2 - 3.0 * b1 * b3;
IF rt < 0 THEN
y := Min( y1, y2 );
h := ABS( y2 - y1 );
ELSE
rt := Math.sqrt( rt );
t := ( -b2 - rt ) / 3 / b3;
IF ( t > 0 ) & ( t < 1 ) THEN
temp := t * ( b2 + t * b3 );
y3 := SHORT( ENTIER( b0 + t * ( b1 + temp ) ) );
ELSE
y3 := y1;
END;
t := ( -b2 + rt ) / 3 / b3;
IF ( t > 0 ) & ( t < 1 ) THEN
temp := t * ( b2 + t * b3 );
y4 := SHORT( ENTIER( b0 + t * ( b1 + temp ) ) );
ELSE
y4 := y1;
END; (* IF *)
y := Min( y1, Min( y2, Min( y3, y4 ) - 1 ) );
h := Max( y1, Max( y2, Max( y3, y4 ) + 1 ) ) - y;
END; (* IF *)
END; (* IF *)
DEC( x, 2 ); DEC( y, 2 ); INC( w, 4 ); INC( h, 4 );
END GetBoundingBox;
PROCEDURE Intersect( f : KeplerPorts.Port; x, y, w, h : INTEGER ) : BOOLEAN;
(* Pr
ft, ob sich der Frame f mit dem Rechteck ( x, y, w, h )
berschneidet. *)
VAR t : INTEGER;
BEGIN (* Intersect *)
x := f.CX( x ); y := f.CY( y ); w := w DIV f.scale; h := h DIV f.scale;
t := x + w;
IF f.X > x THEN x := f.X END;
IF f.X + f.W < t THEN
w := f.X + f.W - x;
ELSE
w := t - x;
END;
IF w <= 0 THEN RETURN FALSE END;
t := y + h;
IF f.Y > y THEN y := f.Y END;
IF f.Y + f.H < t THEN
h := f.Y + f.H - y;
ELSE
h := t - y;
END;
RETURN h > 0
END Intersect;
PROCEDURE DrawCurve( f : KeplerPorts.Port; a3, a2, a1, a0, b3, b2, b1, b0 : REAL );
(* Zeichnet die Kurve mit den Koeffizienten a3, a2, a1, a0, b3, b2, b1, b0 in den Frame f. *)
PROCEDURE DrawRec( lo, hi : REAL );
(* Zeichnet rekursiv den Spline im Bereich lo, hi. *)
VAR xlo, xhi, ylo, yhi : INTEGER;
med : REAL;
BEGIN (* DrawRec *)
xlo := SHORT( ENTIER( a0 + lo * ( a1 + lo * ( a2 + lo * a3 ) ) ) );
xhi := SHORT( ENTIER( a0 + hi * ( a1 + hi * ( a2 + hi * a3 ) ) ) );
ylo := SHORT( ENTIER( b0 + lo * ( b1 + lo * ( b2 + lo * b3 ) ) ) );
yhi := SHORT( ENTIER( b0 + hi * ( b1 + hi * ( b2 + hi * b3 ) ) ) );
IF ABS( xhi - xlo ) + ABS( yhi - ylo ) <= 2 * f.scale THEN
f.DrawLine( xlo, ylo, xhi, yhi, Display.white, Display.replace );
ELSE
med := ( lo + hi ) / 2;
DrawRec( lo, med );
DrawRec( med, hi );
END; (* IF *)
END DrawRec;
BEGIN (* DrawCurve *)
DrawRec( 0, 1 );
END DrawCurve;
(* ------------------------------ Catmull-Rom Spline ----------------------------------- *)
PROCEDURE ( s : CRSpline ) Draw*( f : KeplerPorts.Port );
(* druckt ein Catmull-Rom Spline auf den Bildschirm *)
VAR a3, a2, a1, a0, b3, b2, b1, b0 : REAL;
x, y, w, h, t : INTEGER;
BEGIN (* Draw *)
t := s.p[ 3 ].x - 3 * s.p[ 2 ].x; a3 := ( t + 3 * s.p[ 1 ].x - s.p[ 0 ].x ) / 2;
t := -s.p[ 3 ].x + 4 * s.p[ 2 ].x; a2 := ( t - 5 * s.p[ 1 ].x + 2 * s.p[ 0 ].x ) / 2;
a1 := ( s.p[ 2 ].x - s.p[ 0 ].x ) / 2;
a0 := s.p[ 1 ].x;
t := s.p[ 3 ].y - 3 * s.p[ 2 ].y; b3 := ( t + 3 * s.p[ 1 ].y - s.p[ 0 ].y ) / 2;
t := -s.p[ 3 ].y + 4 * s.p[ 2 ].y; b2 := ( t - 5 * s.p[ 1 ].y + 2 * s.p[ 0 ].y ) / 2;
b1 := ( s.p[ 2 ].y - s.p[ 0 ].y ) / 2;
b0 := s.p[ 1 ].y;
GetBoundingBox( a3, a2, a1, a0, b3, b2, b1, b0, s.p[ 1 ].x, s.p[ 1 ].y, s.p[ 2 ].x, s.p[ 2 ].y, x, y, w, h );
IF f IS KeplerPorts.BalloonPort THEN
f.DrawRect( x, y, w, h, 0, 0 );
ELSIF Intersect( f, x, y, w, h ) THEN
DrawCurve( f, a3, a2, a1, a0, b3, b2, b1, b0 );
END;
END Draw;
PROCEDURE NewCRSpline*;
(* Liest alle Fokuspunkte ein und legt ein Catmull-Rom Spline durch sie hindurch. *)
VAR s, s1 : CRSpline;
BEGIN (* NewOpenCRSpline *)
IF KeplerFrames.nofpts >= 4 THEN
NEW( s );
s.nofpts := 4;
KeplerFrames.ConsumePoint( s.p[ 0 ] );
KeplerFrames.ConsumePoint( s.p[ 1 ] );
KeplerFrames.ConsumePoint( s.p[ 2 ] );
KeplerFrames.ConsumePoint( s.p[ 3 ] );
KeplerFrames.Focus.Append( s );
WHILE KeplerFrames.nofpts > 0 DO
NEW( s1 );
s1.nofpts := 4;
s1.p[ 0 ] := s.p[ 1 ]; INC( s1.p[ 0 ].refcnt );
s1.p[ 1 ] := s.p[ 2 ]; INC( s1.p[ 1 ].refcnt );
s1.p[ 2 ] := s.p[ 3 ]; INC( s1.p[ 2 ].refcnt );
KeplerFrames.ConsumePoint( s1.p[ 3 ] );
s := s1;
KeplerFrames.Focus.Append( s );
END; (* WHILE *)
END; (* IF *)
END NewCRSpline;
PROCEDURE NewClosedCRSpline*;
(* Liest alle Fokuspunkte ein und legt ein geschlossenes Catmull-Rom Spline durch sie hindurch. *)
VAR s, s1 : CRSpline;
point : ARRAY 3 OF KeplerGraphs.Star;
i : INTEGER;
BEGIN (* NewClosedCRSpline *)
IF KeplerFrames.nofpts >= 4 THEN
NEW( s );
s.nofpts := 4;
KeplerFrames.ConsumePoint( s.p[ 0 ] ); point[ 0 ] := s.p[ 0 ];
KeplerFrames.ConsumePoint( s.p[ 1 ] ); point[ 1 ] := s.p[ 1 ];
KeplerFrames.ConsumePoint( s.p[ 2 ] ); point[ 2 ] := s.p[ 2 ];
KeplerFrames.ConsumePoint( s.p[ 3 ] );
KeplerFrames.Focus.Append( s );
WHILE KeplerFrames.nofpts > 0 DO
NEW( s1 );
s1.nofpts := 4;
s1.p[ 0 ] := s.p[ 1 ]; INC( s1.p[ 0 ].refcnt );
s1.p[ 1 ] := s.p[ 2 ]; INC( s1.p[ 1 ].refcnt );
s1.p[ 2 ] := s.p[ 3 ]; INC( s1.p[ 2 ].refcnt );
KeplerFrames.ConsumePoint( s1.p[ 3 ] );
s := s1;
KeplerFrames.Focus.Append( s );
END; (* WHILE *)
FOR i := 0 TO 2 DO
NEW( s1 );
s1.nofpts := 4;
s1.p[ 0 ] := s.p[ 1 ]; INC( s1.p[ 0 ].refcnt );
s1.p[ 1 ] := s.p[ 2 ]; INC( s1.p[ 1 ].refcnt );
s1.p[ 2 ] := s.p[ 3 ]; INC( s1.p[ 2 ].refcnt );
s1.p[ 3 ] := point[ i ]; INC( s1.p[ 3 ].refcnt );
s := s1;
KeplerFrames.Focus.Append( s );
END; (* FOR *)
END; (* IF *)
END NewClosedCRSpline;
(* ----------------------------------- Bezier-Kurve ------------------------------- *)
PROCEDURE ( s : Bezier ) Draw*( f : KeplerPorts.Port );
(* Druckt eine Bezier-Kurve auf den Bildschirm *)
VAR a3, a2, a1, a0, b3, b2, b1, b0 : INTEGER;
x, y, w, h, t : INTEGER;
BEGIN (* Draw *)
t := 3 * s.p[ 3 ].x - 5 * s.p[ 2 ].x; a3 := t + 3 * s.p[ 1 ].x - s.p[ 0 ].x;
t := -3 * s.p[ 3 ].x + 6 * s.p[ 2 ].x; a2 := t - 6 * s.p[ 1 ].x + 3 * s.p[ 0 ].x;
a1 := ( s.p[ 1 ].x - s.p[ 0 ].x ) * 3;
a0 := s.p[ 0 ].x;
t := 3 * s.p[ 3 ].y - 5 * s.p[ 2 ].y; b3 := t + 3 * s.p[ 1 ].y - s.p[ 0 ].y;
t := -3 * s.p[ 3 ].y + 6 * s.p[ 2 ].y; b2 := t - 6 * s.p[ 1 ].y + 3 * s.p[ 0 ].y;
b1 := ( s.p[ 1 ].y - s.p[ 0 ].y ) * 3;
b0 := s.p[ 0 ].y;
GetBoundingBox( a3, a2, a1, a0, b3, b2, b1, b0, s.p[ 0 ].x, s.p[ 0 ].y, a3 + a2 + a1 + a0, b3 + b2 + b1 + b0, x, y, w, h );
IF f IS KeplerPorts.BalloonPort THEN
f.DrawRect( x, y, w, h, 0, 0 );
ELSIF Intersect( f, x, y, w, h ) THEN
DrawCurve( f, a3, a2, a1, a0, b3, b2, b1, b0 );
END;
END Draw;
PROCEDURE NewBezier*;
(* Liest eine gerade Anzahl Fokuspunkte ein und legt eine Bezier-Kurve durch sie hindurch. *)
VAR s, s1 : Bezier;
BEGIN
IF KeplerFrames.nofpts >= 4 THEN
NEW( s );
s.nofpts := 4;
KeplerFrames.ConsumePoint( s.p[ 0 ] );
KeplerFrames.ConsumePoint( s.p[ 1 ] );
KeplerFrames.ConsumePoint( s.p[ 2 ] );
KeplerFrames.ConsumePoint( s.p[ 3 ] );
KeplerFrames.Focus.Append( s );
WHILE KeplerFrames.nofpts > 1 DO
NEW( s1 );
s1.nofpts := 4;
s1.p[ 0 ] := s.p[ 2 ]; INC( s1.p[ 0 ].refcnt );
s1.p[ 1 ] := s.p[ 3 ]; INC( s1.p[ 1 ].refcnt );
KeplerFrames.ConsumePoint( s1.p[ 2 ] );
KeplerFrames.ConsumePoint( s1.p[ 3 ] );
s := s1;
KeplerFrames.Focus.Append( s );
END; (* WHILE *)
END; (* IF *)
END NewBezier;
PROCEDURE NewClosedBezier*;
(* Liest eine gerade Anzahl Fokuspunkte ein und legt eine Bezier-Kurve durch sie hindurch. *)
VAR s, s1, s0 : Bezier;
BEGIN
IF KeplerFrames.nofpts >= 4 THEN
NEW( s ); s0 := s; s1 := s;
s.nofpts := 4;
KeplerFrames.ConsumePoint( s.p[ 0 ] );
KeplerFrames.ConsumePoint( s.p[ 1 ] );
KeplerFrames.ConsumePoint( s.p[ 2 ] );
KeplerFrames.ConsumePoint( s.p[ 3 ] );
KeplerFrames.Focus.Append( s );
WHILE KeplerFrames.nofpts > 1 DO
NEW( s1 );
s1.nofpts := 4;
s1.p[ 0 ] := s.p[ 2 ]; INC( s1.p[ 0 ].refcnt );
s1.p[ 1 ] := s.p[ 3 ]; INC( s1.p[ 1 ].refcnt );
KeplerFrames.ConsumePoint( s1.p[ 2 ] );
KeplerFrames.ConsumePoint( s1.p[ 3 ] );
s := s1;
KeplerFrames.Focus.Append( s )
END ;
NEW(s);
s.nofpts := 4;
s.p[ 0 ] := s1.p[ 2 ]; INC(s.p[ 0 ].refcnt);
s.p[ 1 ] := s1.p[ 3 ]; INC(s.p[ 1 ].refcnt);
s.p[ 2 ] := s0.p[ 0 ]; INC(s.p[ 2 ].refcnt);
s.p[ 3 ] := s0.p[ 1 ]; INC(s.p[ 3 ].refcnt);
KeplerFrames.Focus.Append( s )
END
END NewClosedBezier;
END Kepler6.